home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
MATH
/
MFLOAT10.ZIP
/
PFLOAT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-04-28
|
13KB
|
281 lines
UNIT pfloat;
{ *** Procedures for calculation with mfloat numbers *** }
INTERFACE
{$F+}
{----------------------------------------------------------------------------}
{ mfloat types }
{----------------------------------------------------------------------------}
CONST MfloatWords = 16;
TYPE mfloat = ARRAY[0..MfloatWords-1] OF integer;
{----------------------------------------------------------------------------}
{ mfloat basic functions }
{----------------------------------------------------------------------------}
PROCEDURE SetMantissawords(number : integer);
FUNCTION GetMantissawords : integer;
PROCEDURE ResetError;
FUNCTION GetError : boolean;
PROCEDURE equm( VAR a, b : mfloat); { *** a <-- b *** }
PROCEDURE addm( VAR a, b : mfloat); { *** a <-- a + b *** }
PROCEDURE subm( VAR a, b : mfloat); { *** a <-- a - b *** }
PROCEDURE multm( VAR a, b : mfloat); { *** a <-- a * b *** }
PROCEDURE divm( VAR a, b : mfloat); { *** a <-- a / b *** }
PROCEDURE multi( VAR a : mfloat; b : integer); { *** a <-- a * b *** }
PROCEDURE divi( VAR a : mfloat; b : integer); { *** a <-- a / b *** }
PROCEDURE inversm(VAR a : mfloat); { *** a <-- 1 / a *** }
PROCEDURE negm( VAR a : mfloat); { *** a <- - a *** }
FUNCTION eqZero( VAR a : mfloat) : boolean; { *** eqZero <-- a = 0 *** }
FUNCTION gtZero( VAR a : mfloat) : boolean; { *** gtZero <-- a > 0 *** }
FUNCTION geZero( VAR a : mfloat) : boolean; { *** geZero <-- a >= 0 *** }
FUNCTION gtm( VAR a, b : mfloat) : boolean; { *** gtm <-- a > b *** }
FUNCTION eqm( VAR a, b : mfloat) : boolean; { *** eqm <-- a = b *** }
PROCEDURE GetZerom(VAR a : mfloat); { *** a <- 0 *** }
PROCEDURE GetOnem(VAR a : mfloat); { *** a <- 1 *** }
PROCEDURE GetPim( VAR a : mfloat); { *** a <- pi *** }
PROCEDURE GetLn2m(VAR a : mfloat); { *** a <- ln(2) *** }
PROCEDURE GetLn10m(VAR a : mfloat); { *** a <- ln(10) *** }
FUNCTION strtomf(VAR a : mfloat; { *** a <-- string *** }
b : string)
: integer;
FUNCTION mftoa( VAR a : mfloat; { *** string <-- a *** }
len : integer) { !!! compare with C }
: string;
FUNCTION mftostr(VAR a : mfloat; { *** string <-- a *** }
len : integer; { !!! compare with C }
format : string)
: string;
FUNCTION MfToD( VAR a : mfloat) : double; { *** MfToD <- a *** }
FUNCTION MfToLd( VAR a : mfloat) : extended; { *** MfToLd <- a *** }
PROCEDURE DToMf( VAR a : mfloat; b : double); { *** a <- b *** }
PROCEDURE LdToMf( VAR a : mfloat; b : extended);{ *** a <- b *** }
{----------------------------------------------------------------------------}
{ standard functions (Borland C: MATH.H) }
{----------------------------------------------------------------------------}
PROCEDURE acosm( VAR a : mfloat); { *** a <- arccos(a) *** }
PROCEDURE asinm( VAR a : mfloat); { *** a <- arcsin(a) *** }
PROCEDURE atanm( VAR a : mfloat); { *** a <- arctan(a) *** }
PROCEDURE atan2m( VAR a, b : mfloat); { *** a <- atan2(a, b) *** }
{ atof see strtomf }
PROCEDURE ceilm( VAR a : mfloat); { *** a <-- ceil(a) *** }
PROCEDURE cosm( VAR a : mfloat); { *** a <- cos(a) *** }
PROCEDURE coshm( VAR a : mfloat); { *** a <- cosh(a) *** }
PROCEDURE expm( VAR a : mfloat); { *** a <- exp(a) *** }
PROCEDURE fabsm( VAR a : mfloat); { *** a <-- fabs(a) *** }
PROCEDURE floorm( VAR a : mfloat); { *** a <-- floor(a) *** }
PROCEDURE fmodm( VAR a, b : mfloat); { *** a <- fmod(a,b) *** }
PROCEDURE frexpm( VAR a : mfloat;
VAR b : integer); { *** a <- frexp(a,b) *** }
PROCEDURE hypotm( VAR a, b : mfloat); { *** a <- hypot(a,b) *** }
PROCEDURE ldexpm( VAR a : mfloat; b : integer); { *** a <- ldexp(a,b) *** }
PROCEDURE logm( VAR a : mfloat); { *** a <- ln(a) *** }
PROCEDURE log10m( VAR a : mfloat); { *** a <- log10(a) *** }
PROCEDURE modfm( VAR a, b : mfloat); { *** a, b <- modf(a) *** }
PROCEDURE powm( VAR a, b : mfloat); { *** a <- a**b *** }
PROCEDURE pow10m( VAR a : mfloat; b : integer); { *** a <- 10**b *** }
PROCEDURE sinm( VAR a : mfloat); { *** a <- sin(a) *** }
PROCEDURE sinhm( VAR a : mfloat); { *** a <- sinh(a) *** }
PROCEDURE sqrtm( VAR a : mfloat); { *** a <- sqrt(a) *** }
PROCEDURE tanm( VAR a : mfloat); { *** a <- tan(a) *** }
PROCEDURE tanhm( VAR a : mfloat); { *** a <- tanh(a) *** }
{----------------------------------------------------------------------------}
{ extended standard functions }
{----------------------------------------------------------------------------}
PROCEDURE acoshm( VAR a : mfloat); { *** a <- arcosh(a) *** }
PROCEDURE acotm( VAR a : mfloat); { *** a <- arccot(a) *** }
PROCEDURE acothm( VAR a : mfloat); { *** a <- arcoth(a) *** }
PROCEDURE asinhm( VAR a : mfloat); { *** a <- arsinh(a) *** }
PROCEDURE atanhm( VAR a : mfloat); { *** a <- artanh(a) *** }
PROCEDURE cossinm(VAR a,b : mfloat); { *** a <- cos(a), b <- sin(a) *** }
PROCEDURE cotm( VAR a : mfloat); { *** a <- cot(a) *** }
PROCEDURE cothm( VAR a : mfloat); { *** a <- coth(a) *** }
PROCEDURE exp10m( VAR a : mfloat); { *** a <- 10 ** a *** }
PROCEDURE sqrm( VAR a : mfloat); { *** a <- sqr(a) *** }
PROCEDURE truncm( VAR a : mfloat); { *** a <-- trunc(a) *** }
{----------------------------------------------------------------------------}
IMPLEMENTATION
{$L mfloata.obj}
{$L mfloatb.obj}
{----------------------------------------------------------------------------}
{ initialized static variables }
{----------------------------------------------------------------------------}
const
mantissawords : integer = MfloatWords-1;
calculationerror : boolean = false;
{----------------------------------------------------------------------------}
{ externals }
{----------------------------------------------------------------------------}
{ mfloat basic functions }
PROCEDURE SetMantissawords(number : integer); external;
FUNCTION GetMantissawords : integer; external;
PROCEDURE ResetError; external;
FUNCTION GetError : boolean; external;
PROCEDURE equm( VAR a, b : mfloat); external;
PROCEDURE addm( VAR a, b : mfloat); external;
PROCEDURE subm( VAR a, b : mfloat); external;
PROCEDURE multm( VAR a, b : mfloat); external;
PROCEDURE divm( VAR a, b : mfloat); external;
PROCEDURE multi( VAR a : mfloat; b : integer); external;
PROCEDURE divi( VAR a : mfloat; b : integer); external;
PROCEDURE inversm(VAR a : mfloat); external;
PROCEDURE negm( VAR a : mfloat); external;
FUNCTION eqZero( VAR a : mfloat) : boolean; external;
FUNCTION gtZero( VAR a : mfloat) : boolean; external;
FUNCTION geZero( VAR a : mfloat) : boolean; external;
FUNCTION gtm( VAR a, b : mfloat) : boolean; external;
FUNCTION eqm( VAR a, b : mfloat) : boolean; external;
PROCEDURE GetZerom(VAR a : mfloat); external;
PROCEDURE GetOnem(VAR a : mfloat); external;
PROCEDURE GetPim( VAR a : mfloat); external;
PROCEDURE GetLn2m(VAR a : mfloat); external;
PROCEDURE GetLn10m(VAR a : mfloat); external;
PROCEDURE DToMf( VAR a : mfloat; b : double); external;
PROCEDURE LdToMf( VAR a : mfloat; b : extended);external;
{ standard functions }
PROCEDURE acosm( VAR a : mfloat); external;
PROCEDURE asinm( VAR a : mfloat); external;
PROCEDURE atanm( VAR a : mfloat); external;
PROCEDURE atan2m( VAR a, b : mfloat); external;
PROCEDURE ceilm( VAR a : mfloat); external;
PROCEDURE cosm( VAR a : mfloat); external;
PROCEDURE coshm( VAR a : mfloat); external;
PROCEDURE expm( VAR a : mfloat); external;
PROCEDURE fabsm( VAR a : mfloat); external;
PROCEDURE floorm( VAR a : mfloat); external;
PROCEDURE fmodm( VAR a, b : mfloat); external;
PROCEDURE frexpm( VAR a : mfloat;
VAR b : integer); external;
PROCEDURE hypotm( VAR a, b : mfloat); external;
PROCEDURE ldexpm( VAR a : mfloat; b : integer); external;
PROCEDURE logm( VAR a : mfloat); external;
PROCEDURE log10m( VAR a : mfloat); external;
PROCEDURE modfm( VAR a, b : mfloat); external;
PROCEDURE powm( VAR a, b : mfloat); external;
PROCEDURE pow10m( VAR a : mfloat; b : integer); external;
PROCEDURE sinm( VAR a : mfloat); external;
PROCEDURE sinhm( VAR a : mfloat); external;
PROCEDURE sqrtm( VAR a : mfloat); external;
PROCEDURE tanm( VAR a : mfloat); external;
PROCEDURE tanhm( VAR a : mfloat); external;
{ extended standard functions }
PROCEDURE acoshm( VAR a : mfloat); external;
PROCEDURE acotm( VAR a : mfloat); external;
PROCEDURE acothm( VAR a : mfloat); external;
PROCEDURE asinhm( VAR a : mfloat); external;
PROCEDURE atanhm( VAR a : mfloat); external;
PROCEDURE cossinm(VAR a,b : mfloat); external;
PROCEDURE cotm( VAR a : mfloat); external;
PROCEDURE cothm( VAR a : mfloat); external;
PROCEDURE exp10m( VAR a : mfloat); external;
PROCEDURE sqrm( VAR a : mfloat); external;
PROCEDURE truncm( VAR a : mfloat); external;
{ internal functions }
PROCEDURE SetMantissawords_(number : integer); external;
PROCEDURE mftostr_(VAR str;
VAR a : mfloat;
VAR len : integer;
VAR format); external;
FUNCTION strtomf_(VAR a : mfloat;
VAR b;
len : integer) : integer; external;
PROCEDURE MfToD_( VAR a : double; VAR b : mfloat); external;
PROCEDURE MfToLd_(VAR a : extended; VAR b : mfloat);external;
{----------------------------------------------------------------------------}
PROCEDURE SetMantissawords(number : integer);
begin
if number > MfloatWords-1 then
number := MfloatWords-1;
SetMantissawords_(number);
end;
{----------------------------------------------------------------------------}
FUNCTION strtomf(VAR a : mfloat;
b : string)
: integer;
begin
strtomf := strtomf_(a,b[1],ord(b[0]));
end;
{----------------------------------------------------------------------------}
FUNCTION mftoa( VAR a : mfloat; { *** string <-- a *** }
len : integer) { !!! compare with C }
: string;
const format : string[8] = '.32767F'+#0;
var tmp : string;
begin
if len > 255 then len := 255;
mftostr_(tmp[1],a,len,format[1]);
tmp[0] := chr(len);
mftoa := tmp;
end;
{----------------------------------------------------------------------------}
FUNCTION mftostr(VAR a : mfloat;
len : integer;
format : string)
: string;
var tmp : string;
begin
if len > 255 then len := 255;
if length(format) = 255 then format[255] := #0
else format[length(format)+1] := #0;
mftostr_(tmp[1],a,len,format[1]);
tmp[0] := chr(len);
mftostr := tmp;
end;
{----------------------------------------------------------------------------}
FUNCTION MfToD( VAR a : mfloat) : double;
var
tmp : double;
begin
MfToD_(tmp,a);
MfToD := tmp;
end;
{----------------------------------------------------------------------------}
FUNCTION MfToLd( VAR a : mfloat) : extended; { *** MfToLd <- a *** }
var
tmp : extended;
begin
MfToLd_(tmp,a);
MfToLd := tmp;
end;
{----------------------------------------------------------------------------}
end.